home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 5 / Apprentice-Release5.iso / Environments / Yerk 3.6.8 / tool+ / resources < prev    next >
Encoding:
Text File  |  1994-12-06  |  3.8 KB  |  136 lines  |  [TEXT/MACA]
  1. \ 12.5.89    rfl    general resource handling classes
  2. \ 2.1.90    rfl    resrc now subclass of handle
  3. \ 11.28.90    rfl    added type: stringlist
  4. \ 10.20.91    rfl    took out abort if sound resource snd not found
  5.  
  6. create copyHandle popa0 " HandToHand" asmcall pusha0 next,
  7.  
  8. :CLASS resrc <super handle
  9.  
  10.   int resID
  11.  
  12.   :M putResID: put: resID ;M
  13.   :M error: word0 call ResError i->l ;M
  14.   :M changed: m@ call changedResource error: self abort" no Change" ;M
  15.   :M save: changed: self m@ call writeResource error: self abort" no Write" ;M
  16.   :M getRef: ( -- n) word0 m@ call HomeResFile i->l ;M
  17.   :M close: getref: self makeint call closeResFile ;M
  18.   :M release: m@ call releaseResource 0 m! ;M
  19.   :M size: 0 m@ call sizeResource ;M
  20.   :M detach: m@ call detachResource ;M
  21.   :M remove: m@ call rmveResource ;M
  22.   :M add: { type resID addr len -- }
  23.         m@ type resID makeint addr len str255 call addResource ;M
  24.   :M getnew: ( restype -- ) get: resID swap (getres) dup m! not IF errbeep THEN ;M
  25.  
  26. ;CLASS
  27.  
  28. false value quiet    \ global true if want sounds    
  29.  
  30. \ resource type 'snd'
  31. :CLASS snd <super resrc
  32.  
  33.     int async
  34.     var sndChannel
  35.  
  36.   :M async: 1 put: async ;M
  37.   :M sync:  clear: async ;M
  38.  
  39.   :M getNew: 'type snd getNew: super ;M
  40.  
  41.   :M newChannel: 0 abs: sndChannel word0 0 0 call SndNewChannel drop ;M
  42.   :M disposeChannel: 0 abs: sndChannel word0 call SndDisposeChan drop ;M
  43.  
  44. \ the sound is already loaded in. this will just play the sound
  45.   :M play: ( --) 0 get: async
  46.     IF    newChannel: self get: sndChannel m@ 1 bool call SndPlay disposeChannel: self
  47.     ELSE  0 m@ word0 call SndPlay
  48.     THEN  drop ;M
  49.  
  50. \ like picture disp: ; resID on stack, this will say the sound and leave it in heap
  51.   :M disp: ( resID --) put: resID getnew: self play: self ;M
  52.  
  53. \ the resID is stored with the object, say: will load the sound and say it
  54.   :M say: ( --) getNew: self play: self ;M
  55.  
  56. \ to be used to take an resID from stack, load a sound, say it, and purge it
  57. \ like getstring; no action if quiet=true
  58.   :M blurt: ( resID --) quiet not IF disp: self release: self ELSE drop THEN ;M
  59.  
  60. ;CLASS
  61.  
  62. snd sound    \ instantiate a global sound object
  63.  
  64. : ?say ( b snd# --) swap IF blurt: sound ELSE drop THEN ;
  65.  
  66. \ 8.25.89    rfl    class for handling STR# resources. This is basically a static
  67. \                string array. Put STR# into resource file, and handle it this
  68. \                way, however the maximum string length is 255 characters.
  69. \                Eventually, the array could be made dynamic.
  70.  
  71. :CODE @String    ( ind addr -- addr len t or f )
  72.         clr.l    d1
  73.         movea.l    (sp)+,a0    \ get resource addr
  74.         move.l    (sp)+,d0    \ get index
  75.         adda.l    a3,a0
  76.         move.w    (a0)+,d7    \ get # of strings
  77.         subq    #1,d7
  78.         cmp.w    d0,d7        \ within limits?
  79.         bge        loop
  80. error    clr.l    -(sp)
  81.         bra        exit
  82. loop    move.b    (a0)+,d1        \ get len
  83.         subq.l    #1,d0        \ dec index
  84.         cmpi.l    #-1,d0
  85.         beq        out
  86.         adda.l    d1,a0        \ go to next index
  87.         bra loop
  88. out        suba.l    a3,a0
  89.         move.l    a0,-(sp)
  90.         move.l    d1,-(sp)
  91.         move.l    #1,-(sp)
  92. exit    nop
  93. ;code
  94.  
  95. hex    \ compare two strings case insensitive
  96. create s=' ( addr len addr len -- tf)
  97.     201f w,        \ move.l    (sp)+,d0
  98.     225f w,        \ movea.l    (sp)+,a1
  99.     241f w,        \ move.l    (sp)+,d2
  100.     2057 w,        \ movea.l    (sp),a0
  101.     4840 w,        \ swap        d0
  102.     3002 w,        \ move.w    d2,d0
  103.     4840 w,        \ swap        d0
  104.     d1cb w,        \ adda.l    a3,a0
  105.     d3cb w,        \ adda.l    a3,a1
  106.     a03c w,        \ call equalString
  107.     0a00 w, 1 w, \ eori.b    #1,d0
  108.     2e80 w,        \ move.l    d0,(sp)
  109. next,
  110. decimal
  111.  
  112. \ resource type 'STR#'
  113. :CLASS StringList <super resrc
  114.  
  115.   :M getNew: 'type STR# getnew: super ;M
  116.  
  117. \ returns # of elements
  118.   :M limit: ( -- n) ptr: self w@ ;M
  119.  
  120.   :M size: limit: self ;M
  121.  
  122.   :M at: ( ind -- addr len) ptr: self @string 0= classerr" 129 ;M
  123.  
  124.   :M type: ( ind --) i at: self type ;M
  125.  
  126.   :M print: limit: self 0 DO i 3 .r space i at: self type cr ?pause LOOP ;M
  127.  
  128. \ finds with case insensitive
  129.   :M indexOf: { addr len \ flag -- ind t or f }
  130.         limit: self 0 false -> flag
  131.         DO addr len i at: self s=' IF i true -> flag LEAVE THEN LOOP
  132.         flag ;M
  133.  
  134. ;CLASS
  135.  
  136.